home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / Pascal / Snippets / ColorIcosahedron 1.0 / Reusable units / OffscreenToysUtils.p < prev   
Text File  |  1995-05-25  |  12KB  |  407 lines
  1. {Minimalist's offscreen package}
  2.  
  3. unit OffscreenToysUtils;
  4.  
  5. interface
  6.     uses
  7.         QDOffScreen, MyFakeAlert;
  8.  
  9. {Generate a random number in a limited range}
  10. {function Rand (range: integer): integer;}
  11.  
  12. {Glue for GWorlds}
  13.     procedure OTGetGWorld (var thePort: GrafPtr; var theDevice: GDHandle);
  14.     procedure OTSetGWorld (thePort: GrafPtr; theDevice: GDHandle);
  15.  
  16. {Glue for cicns}
  17.     function OTGetCicn (cicnId: integer): CIconHandle;
  18.     procedure OTPlotCicn (theCicn: CIconHandle; destWorld: GrafPtr; r: Rect);
  19.     procedure OTDisposeCicn (theCicn: CIconHandle);
  20.     function OTGetBoostCicn (cicnId: integer): GrafPtr;
  21.     procedure OTPlotBoostCicn (theCicn: GrafPtr; where: Point);
  22.  
  23. {PICT boost}
  24.     function OTGetBoostPicture (picID: Integer; box: Rect): GrafPtr;
  25.     procedure OTDrawBoostPicture (thePic: GrafPtr; where: Point);
  26.  
  27. {NewPtr with built-in error check}
  28.     function OTNewPtr (size: Longint): Ptr;
  29.  
  30. {Glue for making GWorlds}
  31.     procedure OTNewGWorld (var offscreenGWorld: GrafPtr; boundsRect: Rect);
  32.     procedure OTDisposeGWorld (var offscreenGWorld: GrafPtr);
  33.  
  34. {Apples code for TrapAvailable}
  35.     function TrapAvailable (theTrap: Integer): Boolean;
  36.  
  37. {Initialize the globals - must be done first!}
  38.     procedure OTInitGlobals;
  39.  
  40.     var
  41.         gColorQDFlag: Boolean;        {True if 32-bit QD exists. If not, we run everything in b/w.}
  42.         gHasWNE: Boolean;        {True if we can use WaitNextEvent}
  43.         gSoundFlag: Boolean;        {True if Sound Manager is around.}
  44.  
  45. implementation
  46.  
  47.     var
  48.         gOTInitialized: Boolean;
  49.  
  50. { --- PART 2: Various general, reuseable routines, mostly glue: ---------------------}
  51.  
  52. {Rand: simply make a random number between 0 and range-1.}
  53.  
  54.     function Rand (range: integer): integer;
  55.     begin
  56.         Rand := abs(Random mod range)
  57.     end;
  58.  
  59. {BailOut: Emergency exit. We go here on most errors. Real programs report what the}
  60. {problem is. You may wish to put a breakpoint in BailOut when debugging.}
  61.  
  62.     procedure BailOut;
  63.     begin
  64. {SysBeep(1); {Minimal error message. Use alert in real programs.}
  65.         ReportStr('Out of memory!');
  66.         halt;
  67.     end;
  68.  
  69. {OTGetGWorld and OTSetGWorld: Glue to GetGWorld and SetGWorld, so this will work}
  70. {without 32-bit QD, if necessary.}
  71.  
  72.     procedure OTGetGWorld (var thePort: GrafPtr; var theDevice: GDHandle);
  73.     begin
  74.         if not gOTInitialized then
  75.             OTInitGlobals;
  76.  
  77.         theDevice := nil;
  78.         if gColorQDFlag then
  79.             GetGWorld(CGrafPtr(thePort), theDevice)
  80.         else
  81.             GetPort(thePort);
  82.     end;
  83.  
  84.     procedure OTSetGWorld (thePort: GrafPtr; theDevice: GDHandle);
  85.     begin
  86.         if not gOTInitialized then
  87.             OTInitGlobals;
  88.  
  89.         if gColorQDFlag then
  90.             SetGWorld(CGrafPtr(thePort), theDevice)
  91.         else
  92.             SetPort(thePort);
  93.     end;
  94.  
  95. {OTGetCicn: Glue to GetCIcon, loads a cicn resource}
  96.  
  97.     function OTGetCicn (cicnId: integer): CIconHandle;
  98.         var
  99.             h: Handle;
  100.     begin
  101.         if not gOTInitialized then
  102.             OTInitGlobals;
  103.  
  104.         if gColorQDFlag then
  105.             begin
  106.                 OTGetCicn := GetCIcon(cicnId);
  107.                 h := GetResource('cicn', cicnID);
  108.                 ReleaseResource(h);
  109.             end
  110.         else
  111.             OTGetCicn := CIconHandle(GetResource('cicn', cicnId));
  112.     end;
  113.  
  114. {OTPlotCicn: Glue to PlotCIcon, plots a cicn.}
  115.  
  116.     procedure OTPlotCicn (theCicn: CIconHandle; destWorld: GrafPtr; r: Rect);
  117.         var
  118.             tempIconBMap, tempIconMask: BitMap;
  119.             savePort: GrafPtr;
  120.             saveDevice: GDHandle;
  121.             datasize: integer;
  122.     begin
  123.         OTGetGWorld(savePort, saveDevice);
  124.         if destWorld <> nil then
  125.             OTSetGWorld(destWorld, nil)
  126.         else
  127.             destWorld := savePort; {So that CopyMask has a GrafPtr!}
  128.         if theCicn <> nil then {If we have a cicn}
  129.             if gColorQDFlag then {We have color - then it's easy.}
  130.                 PlotCicon(r, theCicn)
  131.             else
  132. {No color: Use CopyMask.}
  133. {NOTE: This only works for 9 pixels or wider cicn's! (Old QuickDraw can't handle 1 byte wide bitmaps.)}
  134. {There is a workaround for this, but that is *really* tedious.}
  135.                 begin
  136.                     HLock(Handle(theCicn));
  137. {Make the base address pointers valid}
  138.                     with theCicn^^.iconBMap do
  139.                         datasize := rowBytes * (bounds.bottom - bounds.top);
  140.                     theCicn^^.iconBMap.baseAddr := Ptr(longint(@theCicn^^.iconMaskData[0]) + datasize); {Bitmappen måste vara giltig fört!}
  141.                     theCicn^^.iconMask.baseAddr := @theCicn^^.iconMaskData[0]; {Maskbitmappen måste också vara giltig först!}
  142. {Draw with CopyMask}
  143.                     CopyMask(theCicn^^.iconBMap, theCicn^^.iconMask, destWorld^.portBits, theCicn^^.iconBMap.bounds, theCicn^^.iconBMap.bounds, r);
  144.                     HUnLock(Handle(theCicn));
  145.                 end;
  146.         OTSetGWorld(savePort, saveDevice);
  147.     end;
  148.  
  149.     procedure OTDisposeCicn (theCicn: CIconHandle);
  150.     begin
  151.         if gColorQDFlag then
  152.             DisposeCIcon(theCicn)
  153.         else
  154.             ReleaseResource(Handle(theCicn));
  155.     end;
  156.  
  157. {To avoid a lot of boring checks later, we have a glue for NewPtr, making it emergency}
  158. {exit on out of memory. (This is of course often not what you want, but this is a demo!)}
  159.  
  160.     function OTNewPtr (size: Longint): Ptr;
  161.     begin
  162.         OTNewPtr := NewPtrClear(size);
  163.         if MemError <> noErr then
  164.             BailOut;
  165.     end;
  166.  
  167. {OTNewGWorld: Glue to NewGWorld}
  168. {I declare offscreenGWorld as GrafPtr to save us a bunch of typecasts later (in CopyBits).}
  169. {Most parameters to NewGWorld omitted - NewGWorld is smart enough to make the defaults useable.}
  170.  
  171.     procedure OTNewGWorld (var offscreenGWorld: GrafPtr; boundsRect: Rect);
  172.         var
  173.             theDevice, oldDevice: GDHandle;
  174.             ourCMHandle: CTabHandle;
  175.             err: OsErr;
  176.  
  177.             saveGD: GDHandle;
  178.             savePort: GrafPtr;
  179.     begin
  180.         OTGetGWorld(savePort, saveGD);
  181.  
  182.         if gColorQDFlag then
  183.             begin
  184.                 if noErr <> NewGWorld(GWorldPtr(offscreenGWorld), 0, boundsRect, nil, nil, [pixelsLocked]) then
  185.                     BailOut;
  186. {We lock the offscreen pixmap so we can CopyBits and PlotCIcon to it.}
  187.                 if LockPixels(CGrafPtr(offscreenGWorld)^.portPixMap) then
  188.                     ;
  189. {Note: We should unlock it (UnlockPixels) when not animating, to avoid memory fragmentation,}
  190. {but you can bother with that later if it's a problem.}
  191.             end
  192.         else
  193.             begin
  194. {Not color - setup in b/w}
  195.                 offscreenGWorld := GrafPtr(OTnewPtr(sizeof(GrafPort)));
  196.                 OpenPort(offscreenGWorld);
  197.                 offscreenGWorld^.portRect := boundsRect;
  198.                 offscreenGWorld^.portBits.bounds := offscreenGWorld^.portRect;
  199.  
  200.                 RectRgn(offscreenGWorld^.visRgn, boundsRect);
  201.                 ClipRect(boundsRect);
  202.  
  203.                 offscreenGWorld^.portBits.rowBytes := longint(((offscreenGWorld^.portRect.right - offscreenGWorld^.portRect.left + 15) div 16) * 2);
  204.                 offscreenGWorld^.portBits.baseAddr := OTnewPtr(offscreenGWorld^.portBits.rowBytes * longint(offscreenGWorld^.portRect.bottom - offscreenGWorld^.portRect.top));
  205.             end;
  206.  
  207.         OTSetGWorld(savePort, saveGD);
  208.     end;
  209.  
  210. {OTDisposeGWorld: Glue to DisposeGWorld}
  211.  
  212.     procedure OTDisposeGWorld (var offscreenGWorld: GrafPtr);
  213.     begin
  214.         if gColorQDFlag then
  215.             begin
  216.                 DisposeGWorld(GWorldPtr(offscreenGWorld));
  217.             end
  218.         else
  219.             begin
  220.                 DisposePtr(offscreenGWorld^.portBits.baseAddr);
  221.                 DisposePtr(Ptr(offscreenGWorld));
  222.             end;
  223.         offscreenGWorld := nil;
  224.     end;
  225.  
  226.  
  227. {TrapAvailable from IM6-3-8}
  228.     function NumToolboxTraps: Integer;
  229.     begin
  230.         if NGetTrapAddress($A86E, ToolTrap) = NGetTrapAddress($aa6e, ToolTrap) then {_InitGraf}
  231.             NumToolboxTraps := $200
  232.         else
  233.             NumToolboxTraps := $400;
  234.     end;
  235.     function GetTrapType (theTrap: Integer): TrapType;
  236.         const
  237.             TrapMask = $800;
  238.     begin
  239.         if band(theTrap, TrapMask) > 0 then
  240.             GetTrapType := ToolTrap
  241.         else
  242.             GetTrapType := OSTrap;
  243.     end;
  244.     function TrapAvailable (theTrap: Integer): Boolean;
  245.         var
  246.             tType: TrapType;
  247.     begin
  248.         tType := GetTrapType(theTrap);
  249.         if tType = ToolTrap then
  250.             begin
  251.                 theTrap := band(theTrap, $7ff);
  252.                 if theTrap >= NumToolboxTraps then
  253.                     theTrap := $A89F;{_Unimplemented}
  254.             end;
  255.         TrapAvailable := NGetTrapAddress(theTrap, tType) <> NGetTrapAddress($A89F, ToolTrap);{_Unimplemented}
  256.     end;
  257. {End of code from IM6}
  258.  
  259.     procedure OTInitGlobals;
  260.         const
  261. {Trap numbers}
  262.             _WaitNextEvent = $A860;
  263.             _GetCIcon = $AA1E; {E.g. any Color QuickDraw routine}
  264.             k32bQD = $AB1D;
  265.             _SndPlay = $A805;
  266.     begin
  267.         gHasWNE := TrapAvailable(_WaitNextEvent);
  268.         gColorQDFlag := TrapAvailable(k32bQD) and TrapAvailable(_GetCIcon); {???}
  269.         gSoundFlag := TrapAvailable(_SndPlay);
  270.         randSeed := TickCount;            {Seed the random number generator - TickCount is good enough.}
  271.         gOTInitialized := true;
  272.     end; {OTInitGlobals}
  273.  
  274.  
  275.  
  276.  
  277. {Load a cicn to a GWorld. Wastes some memory, but if it isn't too many, the speed increase pays}
  278. {for it.}
  279.  
  280.     function OTGetBoostCicn (cicnId: integer): GrafPtr;
  281.         var
  282.             offscreenGWorld: GrafPtr;
  283.             theCicn: CIconHandle;
  284.             saveGD: GDHandle;
  285.             savePort: GrafPtr;
  286.     begin
  287.         OTGetGWorld(savePort, saveGD);
  288.         theCicn := OTGetCicn(cicnId);
  289.         OTNewGWorld(offscreenGWorld, theCicn^^.iconMask.bounds);
  290.         if offscreenGWorld <> nil then
  291.             begin {OTSetGWorld(offscreenGWorld, nil); Onödigt!}
  292.                 OTPlotCicn(theCicn, offscreenGWorld, theCicn^^.iconMask.bounds);
  293.  
  294. {I use the clipRgn for storing the mask region. This may seem weird, but when we aren't drawing}
  295. {in the GWorld anyway, it won't matter.}
  296.                 if offscreenGWorld = nil then
  297.                     offscreenGWorld^.clipRgn := NewRgn;
  298.                 if gColorQDFlag and TrapAvailable($A8D7) then {a8d7 = BitMapToRegion}
  299.                     begin
  300.                         if noErr <> BitMapToRegion(offscreenGWorld^.clipRgn, theCicn^^.iconMask) then{}
  301.                             offscreenGWorld^.clipRgn := nil;{or DisposeRgn?}
  302.                     end
  303.                 else {Trap not available - use the glue routine instead.}
  304.                     begin
  305.                         if noErr <> BitMapToRegionGlue(offscreenGWorld^.clipRgn, theCicn^^.iconMask) then{}
  306.                             offscreenGWorld^.clipRgn := nil;{or DisposeRgn?}
  307.                     end;
  308.  
  309.                 OTDisposeCicn(theCicn);
  310.             end;
  311.         OTSetGWorld(savePort, saveGD);
  312.         OTGetBoostCicn := offscreenGWorld;
  313.     end; {OTGetBoostCicn}
  314.  
  315.     var
  316.         gTmpRgn: RgnHandle;
  317.  
  318.     procedure OTPlotBoostCicn (theCicn: GrafPtr; where: Point);
  319.         var
  320.             saveGD: GDHandle;
  321.             savePort: GrafPtr;
  322.             bounds: Rect;
  323.             tmpRgn: RgnHandle;
  324.             saveForeColor, saveBackColor: RGBColor;
  325.     begin
  326.         OTGetGWorld(savePort, saveGD);
  327. {OTSetGWorld(theCicn, nil);}
  328.         bounds := theCicn^.portRect;
  329.         OffsetRect(bounds, where.h - bounds.left, where.v - bounds.top);
  330.  
  331.         if gTmpRgn = nil then
  332.             gTmpRgn := NewRgn; {For top speed, we make this global, and create it only once!}
  333.         CopyRgn(theCicn^.clipRgn, gTmpRgn);
  334.         OffsetRgn(gTmpRgn, where.h, where.v);
  335. {SetPort(destPort); {Device?}
  336.         if gColorQDFlag then
  337.             begin
  338.                 GetForeColor(saveForeColor);
  339.                 GetBackColor(saveBackColor);
  340.             end;
  341.         ForeColor(blackColor);
  342.         BackColor(whiteColor);
  343.         CopyBits(theCicn^.portBits, savePort^.portBits, theCicn^.portRect, bounds, srcCopy, gTmpRgn);
  344. {DisposeRgn(tmpRgn);}
  345.         if gColorQDFlag then
  346.             begin
  347.                 RGBForeColor(saveForeColor);
  348.                 RGBBackColor(saveBackColor);
  349.             end;
  350.         OTSetGWorld(savePort, saveGD);
  351.     end; {OTPlotBoostCicn}
  352.  
  353.  
  354.  
  355.     function OTGetBoostPicture (picID: Integer; box: Rect): GrafPtr;
  356.         var
  357.             offscreenGWorld: GrafPtr;
  358.             thePict: PicHandle;
  359.             saveGD: GDHandle;
  360.             savePort: GrafPtr;
  361. {box: Rect;}
  362.     begin
  363.         OTGetGWorld(savePort, saveGD);
  364.         thePict := GetPicture(picId);
  365. {box := thePict^^.picFrame;}
  366.         OffsetRect(box, -box.left, -box.top);
  367.         OTNewGWorld(offscreenGWorld, box);
  368.         if offscreenGWorld <> nil then
  369.             begin {OTSetGWorld(offscreenGWorld, nil); Onödigt!}
  370.                 OTSetGWorld(offscreenGWorld, nil);
  371.                 EraseRect(offscreenGWorld^.portRect);
  372.                 DrawPicture(thePict, box);
  373.                 ReleaseResource(Handle(thePict));
  374.             end;
  375.         OTSetGWorld(savePort, saveGD);
  376.         OTGetBoostPicture := offscreenGWorld;
  377.     end; {OTGetBoostPicture}
  378.  
  379.     procedure OTDrawBoostPicture (thePic: GrafPtr; where: Point);
  380.         var
  381.             saveGD: GDHandle;
  382.             savePort: GrafPtr;
  383.             bounds: Rect;
  384.             saveForeColor, saveBackColor: RGBColor;
  385.     begin
  386.         OTGetGWorld(savePort, saveGD);
  387.         bounds := thePic^.portRect;
  388.         OffsetRect(bounds, where.h - bounds.left, where.v - bounds.top);
  389.  
  390. {GetPort(destPort); {Device?}
  391.         if gColorQDFlag then
  392.             begin
  393.                 GetForeColor(saveForeColor);
  394.                 GetBackColor(saveBackColor);
  395.             end;
  396.         ForeColor(blackColor);
  397.         BackColor(whiteColor);
  398.         CopyBits(thePic^.portBits, savePort^.portBits, thePic^.portRect, bounds, srcCopy, nil);
  399.         if gColorQDFlag then
  400.             begin
  401.                 RGBForeColor(saveForeColor);
  402.                 RGBBackColor(saveBackColor);
  403.             end;
  404. {OTSetGWorld(savePort, saveGD);}
  405.     end; {OTPlotBoostCicn}
  406.  
  407. end.